home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / match.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-12-08  |  13.2 KB  |  332 lines
  1. (*===========================================================================*)
  2. (* Match a string                                                            *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*   The purpose of this function is to match two strings where one of them  *)
  7. (*   can contain pattern information rather than a straight string to        *)
  8. (*   string comparison.                                                      *)
  9. (*                                                                           *)
  10. (*      Special characters in the pattern are:                               *)
  11. (*                                                                           *)
  12. (*        * -- Matches 0 or more characters of any type                      *)
  13. (*        @ -- a..z, A..Z                                                    *)
  14. (*        # -- 0..9                                                          *)
  15. (*        + -- A..z, A..Z, 0..9                                              *)
  16. (*        ? -- A-F, a-f, 0-9 (a hex number)                                  *)
  17. (*        < -- a..z                                                          *)
  18. (*        > -- A..Z                                                          *)
  19. (*        $ -- =@#+?<>$                                                      *)
  20. (*        = -- Any one character                                             *)
  21. (*        " -- Escape.  The next character in the pattern much match exactly.*)
  22. (*             wild cards will not be interpreted.                           *)
  23. (*        ( -- Group.  A "(" starts a group and a ")" ends it.  For each     *)
  24. (*             group, there must be a matching character in the string.      *)
  25. (*             Example: (abc) matches b.  Wild cards are not interpreted.    *)
  26. (*        \ -- The string to the right of the \ is optional.  It can be      *)
  27. (*             present and if so must match.  If it is missing, it is        *)
  28. (*             a match.  Example: a\a will match with a or aa but not ab     *)
  29. (*                                                                           *)
  30. (*===========================================================================*)
  31.  
  32. {$V-}      (* All checks off *)
  33. {$R-}
  34. {$F-}
  35. {$O+}      (* OK for overlay *)
  36.  
  37. UNIT match;
  38.  
  39. INTERFACE
  40.  
  41. FUNCTION match_str(in_str : STRING; pattern : STRING) : BOOLEAN;
  42.  
  43. (*===========================================================================*)
  44. (* Global variables and types                                                *)
  45. (*===========================================================================*)
  46.  
  47.   TYPE
  48.     match_table         = ARRAY[0..255] OF CHAR;
  49.  
  50.     match_branch_value  = (br_at,
  51.                            br_dollar,
  52.                            br_dq,
  53.                            br_equal,
  54.                            br_gt,
  55.                            br_lparen,
  56.                            br_lt,
  57.                            br_plus,
  58.                            br_pound,
  59.                            br_question,
  60.                            br_star,
  61.                            br_bslash,
  62.                            br_other);
  63.  
  64.     match_branch_array   = ARRAY[0..255] OF match_branch_value;
  65.  
  66.   VAR
  67.     match_strtab       : match_table;
  68.     match_branch_table : match_branch_array;
  69.  
  70. IMPLEMENTATION
  71.  
  72.  
  73.  
  74.  
  75. (*===========================================================================*)
  76. (*                                                                           *)
  77. (*===========================================================================*)
  78.  
  79. FUNCTION match_str(in_str : STRING; pattern : STRING) : BOOLEAN;
  80.  
  81.   VAR
  82.     grptab    : match_table;
  83.  
  84.   (*=========================================================================*)
  85.   (* Subfunction for substring match                                         *)
  86.   (*=========================================================================*)
  87.  
  88. {$S-}      (* All checks off *)
  89.  
  90.   FUNCTION match_subs(ip :BYTE; pp : BYTE) : BOOLEAN;
  91.  
  92.     VAR
  93.       b  : BOOLEAN;
  94.       cp : CHAR;
  95.       cs : CHAR;
  96.       t  : BYTE;
  97.  
  98.     LABEL iterate;
  99.  
  100.     BEGIN;
  101.  
  102.       {$IFDEF prt}
  103.         WRITELN('.', in_str, '/' , pattern);
  104.       {$ENDIF}
  105.  
  106.       (*---------------------------------------------------------------------*)
  107.       (* Set up things                                                       *)
  108.       (*---------------------------------------------------------------------*)
  109.  
  110.       match_subs := FALSE;
  111.  
  112.       (*---------------------------------------------------------------------*)
  113.       (* Loop until we run out of things                                     *)
  114.       (*---------------------------------------------------------------------*)
  115.  
  116.       WHILE (ip <= LENGTH(in_str)) AND (pp <= LENGTH(pattern)) DO
  117.         BEGIN;
  118.  
  119.           (*-----------------------------------------------------------------*)
  120.           (* Get the characters to check                                     *)
  121.           (*-----------------------------------------------------------------*)
  122.  
  123.           cs := in_str[ip];
  124.           cp := pattern[pp];
  125.           t  := ORD(match_strtab[ORD(cs)]);
  126.  
  127.           (*-----------------------------------------------------------------*)
  128.           (* Find out pattern type                                           *)
  129.           (*-----------------------------------------------------------------*)
  130.  
  131.           CASE match_branch_table[ORD(cp)] OF
  132.  
  133.             (*---------------------------------------------------------------*)
  134.             (* Must match exactly!                                           *)
  135.             (*---------------------------------------------------------------*)
  136.  
  137.             br_other :
  138.               BEGIN;
  139.  
  140.                 {$IFDEF prt}
  141.                   WRITELN('CHAR.' , in_c, p_c, '..');
  142.                 {$ENDIF}
  143.  
  144.                 IF cs <> cp THEN EXIT;
  145.                 GOTO iterate;
  146.  
  147.               END;
  148.  
  149.             (*---------------------------------------------------------------*)
  150.             (* Wild card?                                                    *)
  151.             (*---------------------------------------------------------------*)
  152.  
  153.             br_star :
  154.                   BEGIN;
  155.  
  156.                     IF pp = LENGTH(pattern) THEN
  157.                       BEGIN;
  158.                         match_subs := TRUE;
  159.                         EXIT;
  160.                       END;
  161.  
  162.                     b := match_subs(ip, pp + 1);
  163.  
  164.                     IF b THEN
  165.                       BEGIN;
  166.                         match_subs := TRUE;
  167.                         EXIT;
  168.                       END;
  169.  
  170.                     match_subs := match_subs(ip + 1, pp);
  171.  
  172.                     EXIT;
  173.  
  174.                   END;
  175.  
  176.             (*---------------------------------------------------------------*)
  177.             (* Backslash (\)                                                 *)
  178.             (*---------------------------------------------------------------*)
  179.  
  180.             br_bslash :
  181.                   BEGIN;
  182.                     IF pp = LENGTH(pattern) THEN
  183.                       match_subs := FALSE
  184.                     ELSE
  185.                       BEGIN;
  186.                         b := match_subs(ip, pp + 1);
  187.                         match_subs := b;
  188.                       END;
  189.                     EXIT;
  190.                   END;
  191.  
  192.             (*---------------------------------------------------------------*)
  193.             (* Any one character                                             *)
  194.             (*---------------------------------------------------------------*)
  195.  
  196.             br_equal : GOTO iterate;
  197.  
  198.             (*---------------------------------------------------------------*)
  199.             (* Group                                                         *)
  200.             (*---------------------------------------------------------------*)
  201.  
  202.             br_lparen:
  203.                   BEGIN;
  204.  
  205.                     FILLCHAR(grptab, SIZEOF(grptab), CHR(0));
  206.                     INC(pp);
  207.  
  208.                     WHILE (pp <= LENGTH(pattern)) AND (pattern[pp] <> ')') DO
  209.                       BEGIN;
  210.                         grptab[ORD(pattern[pp])] := 'X';
  211.                         INC(pp);
  212.                       END;
  213.  
  214.                     IF (pp > LENGTH(pattern))
  215.                                     OR (grptab[ORD(in_str[ip])] = CHR(0)) THEN
  216.                       EXIT;
  217.  
  218.                     GOTO iterate;
  219.  
  220.                   END;
  221.  
  222.             (*---------------------------------------------------------------*)
  223.             (* Escape                                                        *)
  224.             (*---------------------------------------------------------------*)
  225.  
  226.             br_dq:
  227.                   BEGIN;
  228.  
  229.                     IF pp < LENGTH(pattern) THEN
  230.                       BEGIN;
  231.                         INC(pp);
  232.                         cp := pattern[pp];
  233.                       END;
  234.  
  235.                      IF cs <> cp THEN EXIT;
  236.                      GOTO iterate;
  237.  
  238.                    END;
  239.  
  240.             (*---------------------------------------------------------------*)
  241.             (* 0-9                                                           *)
  242.             (*---------------------------------------------------------------*)
  243.  
  244.             br_pound : t := $08 AND t;
  245.  
  246.             (*---------------------------------------------------------------*)
  247.             (* A-Z, a-z                                                      *)
  248.             (*---------------------------------------------------------------*)
  249.  
  250.             br_at : t := $06 AND t;
  251.  
  252.             (*---------------------------------------------------------------*)
  253.             (* A-Z, a-z, 0-9                                                 *)
  254.             (*---------------------------------------------------------------*)
  255.  
  256.             br_plus : t := $0E AND t;
  257.  
  258.             (*---------------------------------------------------------------*)
  259.             (* Hex number (A-F, a-f, 0-9)                                    *)
  260.             (*---------------------------------------------------------------*)
  261.  
  262.             br_question : t := $20 AND t;
  263.  
  264.             (*---------------------------------------------------------------*)
  265.             (* a-z                                                           *)
  266.             (*---------------------------------------------------------------*)
  267.  
  268.             br_lt : t := $02 AND t;
  269.  
  270.             (*---------------------------------------------------------------*)
  271.             (* A-Z                                                           *)
  272.             (*---------------------------------------------------------------*)
  273.  
  274.             br_gt : t := $04 AND t;
  275.  
  276.             (*---------------------------------------------------------------*)
  277.             (* Special characters (=@#+?<>$)                                 *)
  278.             (*---------------------------------------------------------------*)
  279.  
  280.             br_dollar : t := $01 AND t;
  281.  
  282.           END; (*----- End CASE statment ------------------------------------*)
  283.  
  284.           (*-----------------------------------------------------------------*)
  285.           (* If we fall out here then the variable "t" controls true/false   *)
  286.           (*-----------------------------------------------------------------*)
  287.  
  288.           IF t = 0 THEN EXIT;
  289.  
  290.           (*-----------------------------------------------------------------*)
  291.           (* This is the label we use to ITERATE thru the loop               *)
  292.           (*-----------------------------------------------------------------*)
  293.  
  294. iterate:
  295.  
  296.           INC(ip);
  297.           INC(pp);
  298.  
  299.         END; (*----- End loop thru string -----------------------------------*)
  300.  
  301.       (*---------------------------------------------------------------------*)
  302.       (* Check for the special case of a pattern that ends in * or \         *)
  303.       (*---------------------------------------------------------------------*)
  304.  
  305.       IF (ip <= LENGTH(in_str))
  306.           OR ((pp = LENGTH(pattern)) AND (pattern[pp] <> '*'))
  307.           OR ((pp < LENGTH(pattern)) AND (pattern[pp] <> '\')) THEN EXIT;
  308.  
  309.       (*---------------------------------------------------------------------*)
  310.       (* Whoopie.. We have a match                                           *)
  311.       (*---------------------------------------------------------------------*)
  312.  
  313.       match_subs := TRUE;
  314.  
  315.     END; (*----- End substring matcher --------------------------------------*)
  316.  
  317.   (*=========================================================================*)
  318.   (* Main line!                                                              *)
  319.   (*=========================================================================*)
  320.  
  321.   BEGIN;
  322.  
  323.     (*-----------------------------------------------------------------------*)
  324.     (* Match it                                                              *)
  325.     (*-----------------------------------------------------------------------*)
  326.  
  327.     match_str := match_subs(1, 1)
  328.  
  329.   END;
  330.  
  331. END.
  332.